home *** CD-ROM | disk | FTP | other *** search
/ Mac-Source 1994 July / Mac-Source_July_1994.iso / Other Langs / Tickle-4.0 (tcl) / tcl / extend / src.unused / tclXcmdloop.c < prev    next >
Encoding:
C/C++ Source or Header  |  1993-10-26  |  11.2 KB  |  379 lines  |  [TEXT/MPS ]
  1. /* 
  2.  * tclXcmdloop --
  3.  *
  4.  *   Interactive command loop, C and Tcl callable.
  5.  *-----------------------------------------------------------------------------
  6.  * Copyright 1991-1993 Karl Lehenbauer and Mark Diekhans.
  7.  *
  8.  * Permission to use, copy, modify, and distribute this software and its
  9.  * documentation for any purpose and without fee is hereby granted, provided
  10.  * that the above copyright notice appear in all copies.  Karl Lehenbauer and
  11.  * Mark Diekhans make no representations about the suitability of this
  12.  * software for any purpose.  It is provided "as is" without express or
  13.  * implied warranty.
  14.  *-----------------------------------------------------------------------------
  15.  * $Id: tclXcmdloop.c,v 2.9 1993/08/31 23:03:20 markd Exp $
  16.  *-----------------------------------------------------------------------------
  17.  */
  18.  
  19. #include "tclExtdInt.h"
  20.  
  21. /*
  22.  * Prototypes of internal functions.
  23.  */
  24. static int
  25. IsSetVarCmd _ANSI_ARGS_((char  *command));
  26.  
  27. static void
  28. OutFlush _ANSI_ARGS_((FILE *filePtr));
  29.  
  30. static int
  31. SetPromptVar _ANSI_ARGS_((Tcl_Interp  *interp,
  32.                           char        *hookVarName,
  33.                           char        *newHookValue,
  34.                           char       **oldHookValuePtr));
  35.  
  36.  
  37. /*
  38.  *-----------------------------------------------------------------------------
  39.  * IsSetVarCmd --
  40.  *
  41.  *    Determine if a command is a `set' command that sets a variable
  42.  * (i.e. two arguments).  This routine should only be called if the command
  43.  * returned TCL_OK.  Returns TRUE if it sets a variable, FALSE if its some
  44.  * other command.
  45.  *-----------------------------------------------------------------------------
  46.  */
  47. static int
  48. IsSetVarCmd (command)
  49.     char  *command;
  50. {
  51.     char  *nextPtr;
  52.     int    wordCnt;
  53.  
  54.     if ((!STRNEQU (command, "set", 3)) || (!ISSPACE (command [3])))
  55.         return FALSE;  /* Quick check */
  56.  
  57.     /*
  58.      * Loop to count the words in the command.
  59.      */
  60.     wordCnt = 0;
  61.     nextPtr = command;
  62.     while (*nextPtr != '\0') {
  63.         nextPtr = TclWordEnd (nextPtr, FALSE);
  64.         nextPtr++;  /* Character after the word */
  65.         while ((*nextPtr != '\0') && (ISSPACE (*nextPtr)))
  66.             nextPtr++;
  67.         wordCnt++;
  68.     }
  69.     return wordCnt > 2 ? TRUE : FALSE;
  70. }
  71.  
  72. /*
  73.  *-----------------------------------------------------------------------------
  74.  *
  75.  * OutFlush --
  76.  *
  77.  *   Flush a stdio file and check for errors.  Keeps us from going on if
  78.  * we are really not outputting anything.
  79.  *-----------------------------------------------------------------------------
  80.  */
  81. static void
  82. OutFlush (filePtr)
  83.     FILE *filePtr;
  84. {
  85.     int stat;
  86.  
  87.     stat = fflush (filePtr);
  88.     if (ferror (filePtr)) {
  89.         if (errno != EINTR)
  90.             panic ("command loop: error writing to output file: %s\n",
  91.                    strerror (errno));
  92.         clearerr (filePtr);
  93.     }
  94. }
  95.  
  96. /*
  97.  *-----------------------------------------------------------------------------
  98.  *
  99.  * Tcl_PrintResult --
  100.  *
  101.  *   Print the result of a Tcl.  It can optionally not echo "set" commands
  102.  * that successfully set a variable.
  103.  *
  104.  * Parameters:
  105.  *   o interp (I) - A pointer to the interpreter.  Result of command should be
  106.  *     in interp->result.
  107.  *   o intResult (I) - The integer result returned by Tcl_Eval.
  108.  *   o checkCmd (I) - If not NULL and the command was sucessful, check to
  109.  *     set if this is a "set" command setting a variable.  If so, don't echo
  110.  *     the result. 
  111.  *-----------------------------------------------------------------------------
  112.  */
  113. void
  114. Tcl_PrintResult (interp, intResult, checkCmd)
  115.     Tcl_Interp *interp;
  116.     int         intResult;
  117.     char       *checkCmd;
  118. {
  119.     /*
  120.      * If the command was supplied and it was a successful set of a variable,
  121.      * don't output the result.
  122.      */
  123.     if ((checkCmd != NULL) && (intResult == TCL_OK) && IsSetVarCmd (checkCmd))
  124.         return;
  125.  
  126.     if (intResult == TCL_OK) {
  127.         if (interp->result [0] != '\0') {
  128.             fputs (interp->result, stdout);
  129.             fputs ("\n", stdout);
  130.         }
  131.     } else {
  132.         OutFlush (stdout);
  133.         if (intResult == TCL_ERROR)  
  134.             fputs ("Error: ", stderr);
  135.         else
  136.             fprintf (stderr, "Bad return code (%d): ", intResult);
  137.         fputs (interp->result, stderr);
  138.         fputs ("\n", stderr);
  139.         OutFlush (stderr);
  140.     }
  141. }
  142.  
  143. /*
  144.  *-----------------------------------------------------------------------------
  145.  *
  146.  * Tcl_OutputPrompt --
  147.  *     Outputs a prompt by executing either the command string in
  148.  *     tcl_prompt1 or tcl_prompt2.
  149.  *
  150.  *-----------------------------------------------------------------------------
  151.  */
  152. void
  153. Tcl_OutputPrompt (interp, topLevel)
  154.     Tcl_Interp *interp;
  155.     int         topLevel;
  156. {
  157.     char *hookName;
  158.     char *promptHook;
  159.     int   result;
  160.     int   promptDone = FALSE;
  161.  
  162.     /*
  163.      * If a signal came in, process it.  This prevents signals that are queued
  164.      * from generating prompt hook errors.
  165.      */
  166.     if (tcl_AsyncReady) {
  167.         Tcl_AsyncInvoke (interp, TCL_OK); 
  168.     }
  169.  
  170.     hookName = topLevel ? "tcl_prompt1" : "tcl_prompt2";
  171.  
  172.     promptHook = Tcl_GetVar (interp, hookName, 1);
  173.     if (promptHook != NULL) {
  174.         result = Tcl_Eval (interp, promptHook);
  175.         if (result == TCL_ERROR) {
  176.             fputs ("Error in prompt hook: ", stderr);
  177.             fputs (interp->result, stderr);
  178.             fputs ("\n", stderr);
  179.             Tcl_PrintResult (interp, result, NULL);
  180.         } else {
  181.             fputs (interp->result, stdout);
  182.             promptDone = TRUE;
  183.         }
  184.     } 
  185.     if (!promptDone) {
  186.         if (topLevel)
  187.             fputs ("%", stdout);
  188.         else
  189.             fputs (">", stdout);
  190.     }
  191.     OutFlush (stdout);
  192.     Tcl_ResetResult (interp);
  193. }
  194.  
  195. /*
  196.  *-----------------------------------------------------------------------------
  197.  *
  198.  * Tcl_CommandLoop --
  199.  *
  200.  *   Run a Tcl command loop.  The command loop interactively prompts for,
  201.  * reads and executes commands. Two global variables, "tcl_prompt1" and
  202.  * "tcl_prompt2" contain prompt hooks.  A prompt hook is Tcl code that is
  203.  * executed and its result is used as the prompt string. If a error generating
  204.  * signal occurs while in the command loop, it is reset and ignored.  EOF
  205.  * terminates the loop.
  206.  *
  207.  * Parameters:
  208.  *   o interp (I) - A pointer to the interpreter
  209.  *   o interactive (I) - If TRUE print prompts and non-error results.
  210.  *-----------------------------------------------------------------------------
  211.  */
  212. void
  213. Tcl_CommandLoop (interp, interactive)
  214.     Tcl_Interp *interp;
  215.     int         interactive;
  216. {
  217.     Tcl_DString cmdBuf;
  218.     char        inputBuf [128];
  219.     int         topLevel = TRUE;
  220.     int         result;
  221.  
  222.     Tcl_DStringInit (&cmdBuf);
  223.  
  224.     while (TRUE) {
  225.         /*
  226.          * If a signal came in, process it. Drop any pending command
  227.          * if a "error" signal occured since the last time we were
  228.          * through here.
  229.          */
  230.         if (tcl_AsyncReady) {
  231.             Tcl_AsyncInvoke (interp, TCL_OK); 
  232.         }
  233.         if (tclGotErrorSignal) {
  234.             tclGotErrorSignal = FALSE;
  235.             Tcl_DStringFree (&cmdBuf);
  236.             topLevel = TRUE;
  237.         }
  238.  
  239.         /*
  240.          * Output a prompt and input a command.
  241.          */
  242.         clearerr (stdin);
  243.         clearerr (stdout);
  244.         if (interactive)
  245.             Tcl_OutputPrompt (interp, topLevel);
  246.         errno = 0;
  247.         if (fgets (inputBuf, sizeof (inputBuf), stdin) == NULL) {
  248.             if (!feof(stdin) && (errno == EINTR)) {
  249.                 putchar('\n');
  250.                 continue;  /* Next command */
  251.             }
  252.             if (ferror (stdin))
  253.                 panic ("command loop: error on input file: %s\n",
  254.                        strerror (errno));
  255.             goto endOfFile;
  256.         }
  257.         Tcl_DStringAppend (&cmdBuf, inputBuf, -1);
  258.  
  259.         if (!Tcl_CommandComplete (cmdBuf.string)) {
  260.             topLevel = FALSE;
  261.             continue;  /* Next line */
  262.         }
  263.  
  264.         /*
  265.          * Finally have a complete command, go eval it and maybe output the
  266.          * result.
  267.          */
  268.         result = Tcl_RecordAndEval (interp, cmdBuf.string, 0);
  269.  
  270.         if (interactive || result != TCL_OK)
  271.             Tcl_PrintResult (interp, result, cmdBuf.string);
  272.  
  273.         topLevel = TRUE;
  274.         Tcl_DStringFree (&cmdBuf);
  275.     }
  276. endOfFile:
  277.     Tcl_DStringFree (&cmdBuf);
  278. }
  279.  
  280. /*
  281.  *-----------------------------------------------------------------------------
  282.  *
  283.  * SetPromptVar --
  284.  *     Set one of the prompt hook variables, saving a copy of the old
  285.  *     value, if it exists.
  286.  *
  287.  * Parameters:
  288.  *   o hookVarName (I) - The name of the global variable containing prompt
  289.  *     hook.
  290.  *   o newHookValue (I) - The new value for the prompt hook.
  291.  *   o oldHookValuePtr (O) - If not NULL, then a pointer to a copy of the
  292.  *     old prompt value is returned here.  NULL is returned if there was not
  293.  *     old value.  This is a pointer to a malloc-ed string that must be
  294.  *     freed when no longer needed.
  295.  * Result:
  296.  *   TCL_OK if the hook variable was set ok, TCL_ERROR if an error occured.
  297.  *-----------------------------------------------------------------------------
  298.  */
  299. static int
  300. SetPromptVar (interp, hookVarName, newHookValue, oldHookValuePtr)
  301.     Tcl_Interp *interp;
  302.     char       *hookVarName;
  303.     char       *newHookValue;
  304.     char      **oldHookValuePtr;
  305. {
  306.     char *hookValue;    
  307.     char *oldHookPtr = NULL;
  308.  
  309.     if (oldHookValuePtr != NULL) {
  310.         hookValue = Tcl_GetVar (interp, hookVarName, TCL_GLOBAL_ONLY);
  311.         if (hookValue != NULL)
  312.             oldHookPtr =  ckstrdup (hookValue);
  313.     }
  314.     if (Tcl_SetVar (interp, hookVarName, newHookValue, 
  315.                     TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG) == NULL) {
  316.         if (oldHookPtr != NULL)
  317.             ckfree (oldHookPtr);
  318.         return TCL_ERROR;
  319.     }    
  320.     if (oldHookValuePtr != NULL)
  321.         *oldHookValuePtr = oldHookPtr;
  322.     return TCL_OK;
  323. }
  324.  
  325. /*
  326.  *-----------------------------------------------------------------------------
  327.  *
  328.  * Tcl_CommandloopCmd --
  329.  *     Implements the TCL commandloop command:
  330.  *       commandloop ?prompt1? ?prompt2?
  331.  *
  332.  * Results:
  333.  *     Standard TCL results.
  334.  *
  335.  *-----------------------------------------------------------------------------
  336.  */
  337. int
  338. Tcl_CommandloopCmd(clientData, interp, argc, argv)
  339.     ClientData  clientData;
  340.     Tcl_Interp *interp;
  341.     int         argc;
  342.     char      **argv;
  343. {
  344.     char *oldTopLevelHook  = NULL;
  345.     char *oldDownLevelHook = NULL;
  346.     int   result = TCL_ERROR;
  347.  
  348.     if (argc > 3) {
  349.         Tcl_AppendResult (interp, tclXWrongArgs, argv[0],
  350.                           " ?prompt1? ?prompt2?", (char *) NULL);
  351.         return TCL_ERROR;
  352.     }
  353.     if (argc > 1) {
  354.         if (SetPromptVar (interp, "tcl_prompt1", argv[1],
  355.                           &oldTopLevelHook) != TCL_OK)
  356.             goto exitPoint;
  357.     }
  358.     if (argc > 2) {
  359.         if (SetPromptVar (interp, "tcl_prompt2", argv[2], 
  360.                           &oldDownLevelHook) != TCL_OK)
  361.             goto exitPoint;
  362.     }
  363.  
  364.     Tcl_CommandLoop (interp, TRUE);
  365.  
  366.     if (oldTopLevelHook != NULL)
  367.         SetPromptVar (interp, "topLevelPromptHook", oldTopLevelHook, NULL);
  368.     if (oldDownLevelHook != NULL)
  369.         SetPromptVar (interp, "downLevelPromptHook", oldDownLevelHook, NULL);
  370.         
  371.     result = TCL_OK;
  372. exitPoint:
  373.     if (oldTopLevelHook != NULL)
  374.         ckfree (oldTopLevelHook);
  375.     if (oldDownLevelHook != NULL)
  376.         ckfree (oldDownLevelHook);
  377.     return result;
  378. }
  379.